home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / aie8911.zip / NEWTRACE.ARI < prev    next >
Text File  |  1989-08-27  |  16KB  |  587 lines
  1.  
  2.  
  3. %%%%%%%%%% end prepcomp generated declarations %%%%%%%%%%%%%%%%%%%%
  4.  
  5. % :- module trace .
  6.  
  7. :- extrn har_global_value / 1  : interp.
  8. :- extrn trace_trace / 0 : interp.
  9. :- extrn non_empty / 1 : far.
  10.  
  11.  
  12.  
  13. %%%%%%%%%%%%%%%%%%%%%% end hand coded decs %%%%%%%%%%%%%%%%%%%%%%%%%
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20. %%%%%%%%%%%%%%%%%%% start of version independent code %%%%%%%%%%%%%%
  21.  
  22.  
  23. /*************************************************************************/
  24. /************************   Top of trace.ari     *************************/
  25. /*************************************************************************/
  26. /*  trace_message(X) writes a user-defined trace message on the screen,
  27.  
  28.     example:
  29.  
  30.              trace_message([$X=$,X])
  31.  
  32.     would write when X=3,
  33.  
  34.            % **TRACE***:  X=3
  35.  
  36.     Note: a fancier version that writes also to a file is in Prolog Tools.
  37.           This short version saves scarce space in the interpreter.
  38.  
  39. */
  40.  
  41.  
  42.  
  43. write_fact_trace(X) :-
  44.     call( write_fact_trace),
  45.     !,
  46.     trace_message(X).
  47. write_fact_trace(_).
  48.  
  49. err_file_msg($Error file:$).
  50. err_filename($err.log$).
  51. log_file_msg($log file:$).
  52. log_filename($log.log$).
  53.  
  54. trace_trace :- fail.
  55.  
  56. %%%%%%%%%%%%%%%%%%% msg_to_err_file %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  57. /*
  58. msg_to_err_file( X)
  59. Writes a msg. X to both the screen and to the error file.
  60. */
  61.  
  62. msg_to_err_file( X) :-
  63.       get_err_handle(Handle),
  64.       trace_message_hlpr(Handle,X).
  65.  
  66. %%%%%%%%%%%%%%%%%%% trace_message %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  67. /*
  68. trace_message(X)
  69. Writes a msg. X to both the screen and to the log file.
  70. */
  71.  
  72. trace_message(Flag, Msg) :-
  73.      call( Flag),   !,
  74.      ( trace_message(Msg) , ! ; true).
  75. trace_message( _  , Msg) :- !.
  76.  
  77.  
  78. trace_message(X):-
  79.        (X==pause,!;
  80.         X==$pause$),!,
  81.        press_any.
  82.  
  83. trace_message(X):-
  84.       get_trace_handle(Handle),
  85. %      nl, write($+++++++ handle = $), write(Handle),
  86.       trace_message_hlpr(Handle,X).
  87.  
  88. trace_message_hlpr(Handle,X) :-
  89.       leadoff([1, Handle]),
  90.       trace_msg_hlpr2([1,Handle],X).
  91.  
  92. trace_msg_hlpr2( Handles ,[])  :- !,t_nl( Handles).
  93. trace_msg_hlpr2( Handles ,[H|T])  :-
  94.         atomic( H),
  95.         !,
  96.         trace_msg_hlpr3( Handles ,[H|T])  .
  97. trace_msg_hlpr2( Handles , X)  :-
  98.        write_message(  Handles, X ),
  99.        t_nl( Handles).
  100.  
  101. trace_msg_hlpr3( Handles ,[])  :- !,t_nl( Handles).
  102. trace_msg_hlpr3( Handles ,[H|T])  :- !,
  103.        write_message(  Handles, H ),!,
  104.        trace_msg_hlpr3( Handles, T ).
  105. trace_msg_hlpr3( Handles, X ) :- trace_msg_hlpr3( Handles, [X] ),
  106.                                   !.
  107.  
  108.  
  109. leadoff( [] ) :- !.
  110. leadoff( [H | T ] ) :-
  111.     leadoff_hlpr(H),
  112.     leadoff(T).
  113.  
  114. leadoff_hlpr( X) :-
  115.     integer(X),
  116.     X > 1,
  117.     !,
  118.     t_nl([ X    ]),
  119.     t_write( [   X ], $% **TRACE***: $).
  120.  
  121. leadoff_hlpr( X) :-
  122.     integer(X),
  123.     X = 1,
  124.     !,
  125.     bottom_row(Row),
  126.     tmove(Row,0),
  127.     write(  $% **TRACE***: $).
  128.  
  129. leadoff_hlpr( _ ) :- !.
  130.  
  131. write_message(Handles,X) :- var(X),!, t_write(Handles,$VAR$).
  132. write_message(Handles,X) :- is_nonempty_list(X),!, t_write_list(Handles,X).
  133. write_message(Handles,X) :- write_message_hlpr(Handles,X).
  134.  
  135. %  write_message_hlpr(Handle,X) :-
  136. %              nl, write($ write_message_hlpr : $), write( X),fail.
  137. write_message_hlpr(Handles,X) :- string(X),!, t_write(Handles,X).
  138. write_message_hlpr(Handles,X) :- var(X),!, t_write(Handles,$VAR$).
  139. write_message_hlpr(Handles,X) :- t_writeq(Handles,X).
  140.  
  141. t_nl( []) :- !.
  142.  
  143. t_nl( [H | T ]) :-
  144.      !,
  145.      t_nl_hlpr( H),
  146.      t_nl( T ).
  147.  
  148. t_nl( X) :-
  149.     integer(X),
  150.     !,
  151.     t_nl([X]).
  152.  
  153. t_nl( _).
  154.  
  155. t_nl_hlpr( H ) :-
  156.       H >=0,! ,
  157.       nl(H )  ,
  158.       !.
  159. t_nl_hlpr( _ ) :- !.
  160.  
  161.  
  162.  
  163. t_write( [  ],      X) :-!.
  164. t_write( [ H | T ], X) :-
  165.      t_write_hlpr( H, X ) ,
  166.      !,
  167.      t_write( T , X).
  168. t_write( X) :-
  169.     integer(X),
  170.     !,
  171.     t_write([X]).
  172. t_write( _) .
  173.  
  174. t_write_hlpr( H, X ) :-
  175.       H >=0,
  176.       ! ,
  177.       write(H , X).
  178. t_write_hlpr( _, _ ) :- !.
  179.  
  180.  
  181.  
  182. t_writeq(  [  ],      X) :-!.
  183. t_writeq(  [ H | T ], X) :-
  184.      t_writeq_hlpr( H, X ) ,
  185.      t_writeq( T , X).
  186. t_writeq( X) :-
  187.     integer(X),
  188.     !,
  189.     t_writeq([X]).
  190. t_writeq( _ ) :-!.
  191.  
  192. t_writeq_hlpr( H, X ) :-
  193.       H >=0,
  194.       ! ,
  195.       write_fact_hlpr( H , X   , 0, 0, 1, Used).
  196. t_writeq_hlpr( _, _ ) :- !.
  197.  
  198. t_put( [], _) :- !.
  199. t_put( [H|T], X) :-
  200.        put( H , X),
  201.        t_put( T, X).
  202.  
  203. t_tab( [], _) :- !.
  204. t_tab( [H|T], X) :-
  205.        tab( H , X),
  206.        t_tab( T, X).
  207.  
  208.  
  209. log_read_string( Lnth, String) :-
  210.        read_string( Lnth, String) ,
  211.        log_read_string_hlpr(  String).
  212.  
  213. log_read_string_hlpr(  String) :-
  214.        getglobal( log_file_handle, H),
  215.        H > 1,
  216.        t_write([  H], String),
  217.        nl( H  ),
  218.        !.
  219. log_read_string_hlpr(  _ ) .
  220.  
  221. log_read( Expr ) :-
  222.        read( Expr ) ,
  223.        log_read_hlpr(  Expr  ).
  224.  
  225. log_read_hlpr(  Expr  ) :-
  226.        getglobal( log_file_handle, H),
  227.        H > 1,
  228.        t_writeq([  H], Expr  ),
  229.        t_write([  H], $.$   ),
  230.        nl( H  ),
  231.        !.
  232. log_read_string_hlpr(  _ ) .
  233.  
  234.  
  235. log_writeq(X) :-
  236.        getglobal( log_file_handle, H),
  237.        H > 1,
  238.        !,
  239.        t_writeq([ 1, H],X).
  240. log_writeq(X) :-
  241.        writeq(X).
  242.  
  243. log_write(X) :-
  244.        getglobal( log_file_handle, H),
  245.        H > 1,
  246.        !,
  247.        t_write([ 1, H],X).
  248. log_write(X) :-
  249.        write(X).
  250.  
  251. log_nl :-
  252.        getglobal( log_file_handle, H),
  253.        H > 1,
  254.        !,
  255.        t_nl([ 1, H]).
  256. log_nl :- nl.
  257.  
  258. log_put(X) :-
  259.        getglobal( log_file_handle, H),
  260.        H > 1,
  261.        !,
  262.        t_put([ 1, H], X).
  263. log_put(X) :- put(X).
  264.  
  265. log_tab(X) :-
  266.        getglobal( log_file_handle, H),
  267.        H > 1,
  268.        !,
  269.        t_tab([ 1, H], X).
  270. log_tab(X) :- tab(X).
  271.  
  272.  
  273.  
  274.  
  275.  
  276. log_writeln([]) :- !.
  277.  
  278. log_writeln([Head|Tail]) :- !, log_write(Head),
  279.                                 log_nl,
  280.                                 log_writeln(Tail).
  281.  
  282. log_writeln(Arg) :- log_write(Arg), log_nl.
  283.  
  284.  
  285.  
  286. t_write_list(Handles,[H|T]):-
  287.           %   nl, write($ t_write_list : $), write( [H|T]) ,
  288.           t_write(Handles,$[$) ,        !,
  289.           write_message_hlpr(Handles,H),     !,
  290.           t_write_list_hlpr(Handles,T).
  291. t_write_list_hlpr(Handles,[]) :-
  292.           t_write(Handles,$]$) ,        !.
  293. t_write_list_hlpr(Handles,[H|T]) :-
  294.           %   nl, write($ t_write_list_hlpr : $), write( [H|T]) ,
  295.           t_write(Handles,$,$) ,        !,
  296.           tget(_,Col),                 !,
  297.           %   nl, write($ a tget, Col = $), write( Col  ) ,
  298.           t_write_list_cond_nl(Handles, Col),!,
  299.           write_message_hlpr(Handles,H),  !,
  300.           t_write_list_hlpr(Handles,T) .
  301.  
  302. t_write_list_cond_nl(Handles, Col)  :-
  303.        Col > 40,   !,
  304.        t_nl(Handles),
  305.        t_write(Handles,$% $).
  306. t_write_list_cond_nl(Handles, _  ):- t_write(Handles, $ $).
  307.  
  308. /*************************************************************************/
  309. /***********************  Log file stuff          ************************/
  310. /*************************************************************************/
  311.  
  312.  
  313.  
  314. init_log_file :-
  315. %   call(log_filename(File)),
  316.          log_filename(File) ,
  317. %   call(log_file_msg(Msg)),
  318.          log_file_msg(Msg) ,
  319.     init_file(File, log_file_handle, Msg).
  320.  
  321. init_err_file :-
  322. %   call(err_filename(File)),
  323. %   call(err_file_msg(Msg )),
  324.          err_filename(File ),
  325.          err_file_msg(Msg ) ,
  326.     init_file(File, err_file_handle, Msg).
  327.  
  328. init_file(File, Variable, Msg) :-
  329.    create(Handle,File),
  330.    close(Handle),
  331.    open( Handle2,File, ra),
  332.    setglobal(Variable, Handle2),
  333. %      nl, write($+++++++ $), write(Variable),
  334. %           write($ handle = $), write(Handle),
  335.    (trace_trace, !,
  336.       trace_message([Msg]);
  337.     true).
  338.  
  339. close_log_file :-    close_file( log_file_handle  ).
  340. close_err_file :-    close_file( err_file_handle  ).
  341.  
  342. close_file( Variable) :-
  343.    getglobal(Variable, Handle),
  344.    close( Handle),
  345.    rem_global_value( Variable ).
  346.  
  347. get_trace_handle(Handle) :-
  348.       getglobal(log_file_handle, Handle),!.
  349. get_trace_handle(  -1  ) :- !.
  350.  
  351. get_err_handle(Handle) :-
  352.       getglobal(err_file_handle, Handle),!.
  353. get_err_handle(  -1  ) :- !.
  354.  
  355. err_log( X) :-
  356.       getglobal(err_file_handle, Handle),
  357.       trace_message_hlpr(Handle,X).
  358.  
  359.  
  360. %%%%%%%%%%%%%%%%  global variable predicates %%%%%%%%%%%%%%%%%%%%%%%
  361. % note variable in the following refers to a PROLOG ATOM used as
  362. % a global varible in the application.
  363.  
  364. %%%%%%%%%%%%%%%% setglobal : set value of global variable %%%%%%%%%%
  365.  
  366. setglobal( Var, Val ) :-
  367.        rem_global_value( Var),
  368.        Form =.. [Var, Val],
  369.        asserta( Form),
  370.        let_have_global_value( Var).
  371.  
  372. let_have_global_value( Var) :-
  373.        asserta(har_global_value( Var)).
  374.  
  375. %%%%%%%%%%%%%%%% getglobal : get value of global variable %%%%%%%%%%
  376.  
  377. getglobal( Var, Val) :-
  378.        has_global_value( Var),
  379.        Form =.. [Var, Val],
  380.        call( Form).
  381.  
  382. %%%%%%%%%%%%%%%% has_global_value : true if variable has global value %%%%%
  383.  
  384. has_global_value( Var)  :-
  385.        call(har_global_value( Var)).
  386.  
  387. %%%%%%%%%%%%%%%% rem_global_value : remove global value %%%%%%%%%%%%%%%%%%%
  388.  
  389. rem_global_value( Var) :-
  390.        has_global_value( Var),
  391.        Form =.. [Var, _],
  392.        retract( Form),
  393.        retract( har_global_value( Var)),!.
  394. rem_global_value( _  ).
  395.  
  396.  
  397. /*************************************************************************/
  398. /******* is_nonempty_list : true if argument is a non-empty list *********/
  399. /*************************************************************************/
  400.  
  401. is_nonempty_list([_|_]).
  402.  
  403.  
  404. /*  test
  405. tt :- init_log_file,
  406.       trace_message($hi there$),
  407.       close_log_file,
  408.       shell($type log.log$).
  409. */
  410.  
  411. bottom_row(Row) :-
  412.      tget(R,C),
  413.          % make cursor invisible for search on screen
  414.      hide_cursor,
  415.      bottom_row_hlpr(24,Row),
  416.          % make cursor visible after search on screen
  417.      restore_cursor,
  418.      tmove(R,C).
  419.  
  420. bottom_row_hlpr(Cur, Cur):-
  421.     tmove( Cur,0),!.
  422. bottom_row_hlpr(Cur,Row) :-
  423.       Cur1 is Cur-1,
  424.       bottom_row_hlpr(Cur1,Row).
  425.  
  426. /************  press key to continue    ***********************************/
  427.  
  428. press_any :-   %  message about pressing key
  429.         trace_message($Press any key to continue ...$),
  430.                % get user keystroke without echo
  431.         flush,
  432.         get0_noecho( _ ) .
  433.  
  434. /************  log_listing  ***********************************************/
  435.  
  436. log_listing(  When, What  ) :-
  437.      call( When),
  438.      !,
  439.      log_listing( What) .
  440. log_listing(  _, _   ) :- !.
  441.  
  442. log_listing(  Name / Arity) :-
  443.      getglobal( log_file_handle, H),
  444.      int_text( Arity, S_arity),
  445.     concat([$Listing of $,Name, $ / $,S_arity,$ :$],Msg),
  446.     log_write( Msg),
  447.     log_nl,
  448.     functor( Term, Name, Arity),
  449.     clause( Term, Body),
  450.      write_message_hlpr([ 1, H], ( Term :- Body) ),
  451.      log_nl,
  452.      nl,
  453.      fail.
  454. log_listing(  _ ).
  455.  
  456.  
  457. /******** write_fact *************************************************/
  458. /* writess a fact to where it belongs.
  459.  
  460. CALL : write_fact ( Out_handle, Fact)
  461.  
  462. INPUT ARGS:
  463.  
  464.       Out_handle : where output goes, either file handle or
  465.                    prolog_idb
  466.  
  467.       Fact : what to write out
  468.  
  469. */
  470.  
  471. :- mode write_fact( +, +).
  472.  
  473. write_fact( Out_handle, Fact) :-
  474.         write_fact_trace([$i write_fact, Out_handle = $, Out_handle]),
  475.         fail.
  476.  
  477. write_fact( Out_handle, Fact) :-
  478.          means_put_in_prolog_idb( Out_handle) ,
  479.          !,
  480.          assertz( Fact).
  481.  
  482. write_fact( Out_handle, Fact) :-
  483.       write_fact_hlpr( Out_handle, Fact, 0, 0, 1, Used),
  484.       write( Out_handle, $.$),
  485.       nl( Out_handle ),
  486.       (   Used > 1, !, nl(Out_handle)
  487.        ;  true).
  488.  
  489.  
  490. write_fact_hlpr( Out_handle, Fact, Indent, Current, Lines_used,
  491.                   Total_lines) :-
  492.          Tabs is Indent - Current,
  493.          tab(Out_handle, Tabs),
  494.          string_term( Sfact, Fact),
  495.          string_length( Sfact, Factlnth),
  496.          OK is 76 - Indent,
  497.          (      Factlnth =< OK,
  498.                 !,
  499.                 writeq( Out_handle, Fact),
  500.                 Total_lines is Lines_used
  501.             ;
  502.                 write_fact_hlpr2( Out_handle, Fact, Indent,
  503.                                    Indent , Lines_used, Total_lines)).
  504.  
  505.            % this rule writes atoms
  506. write_fact_hlpr2( Out_handle, Fact, _ , _ , Lines_in, Lines_in) :-
  507.            atomic( Fact),
  508.            !,
  509.            writeq( Out_handle, Fact) .
  510.  
  511.  
  512.            % this rule writes frame slot : value pairs
  513. write_fact_hlpr2( Out_handle,  S:V , N, Current , Lines_used, Total_lines) :-
  514.            !,
  515.            write_fact_hlpr( Out_handle, S, N, Current, Lines_used, Sofar1),
  516.            write(Out_handle, $ : $),
  517.            nl( Out_handle),
  518.            N3 is N+3,
  519.            write_fact_hlpr( Out_handle, V, N3, 0, Sofar1, Total_lines).
  520.  
  521. write_fact_hlpr2( Out_handle, [H|T], N, Current , Lines_used, Total_lines) :-
  522.            !,
  523.            write(Out_handle, $[$),
  524.            NewN is N +  1,
  525.            Current1 is Current+1,
  526.            write_arg( Out_handle, H, T, NewN, Current1, Lines_used, Sofar),
  527.            write_fact_hlpr3( Out_handle, T, NewN, 0, Sofar, Total_lines),
  528.            write( Out_handle, $]$).
  529.  
  530. write_fact_hlpr2( Out_handle, Fact, N, Current, Used, Total ) :-
  531.            Fact =..[ Functor | Args],
  532.            atom_string( Functor, Sfunctor),
  533.            string_length( Sfunctor, Functor_lnth),
  534.            write(Out_handle, Functor),
  535.            write(Out_handle, $($),
  536.            NewN is N + Functor_lnth + 1,
  537.            New_used is Used + 1,
  538.            Current1 is Current+ Functor_lnth +1,
  539.            write_args( Out_handle, Args, NewN, Current1, New_used, Total).
  540.  
  541. write_args( Out_handle,   [], _, _, Used, Used ) :- !.
  542.  
  543. write_args( Out_handle, [Arg | Rest], N, Current, Used, Total) :-
  544.            write_arg( Out_handle, Arg, Rest, N, Current, Used , Sofar),
  545.            write_fact_hlpr3( Out_handle, Rest, N, 0, Sofar, Total),
  546.            write( Out_handle, $)$).
  547.  
  548. write_fact_hlpr3( Out_handle, [], _ , _, Used, Used) :-  !.
  549.  
  550. write_fact_hlpr3( Out_handle, [H|T],  NewN, Current, Used, Total) :-
  551.            Tabs is NewN - Current,
  552.            tab( Out_handle, Tabs),
  553.            write_arg( Out_handle, H , T, NewN , NewN, Used, Sofar),
  554.            write_fact_hlpr3( Out_handle, T,  NewN, 0, Sofar, Total ).
  555.  
  556. write_arg( Out_handle, Arg, Rest, N , Current, Sofar, Total) :-
  557.            write_fact_hlpr( Out_handle, Arg, N, Current, Sofar, Sofar1),
  558.            (    non_empty( Rest ),
  559.                 !,
  560.                 write( Out_handle, $,$),
  561.                 nl( Out_handle),
  562.                 Total is Sofar1 + 1
  563.              ;
  564.                 true,
  565.                 Total is Sofar1
  566.            ).
  567.  
  568.  
  569. /************  means_put_in_prolog_idb ****************************/
  570. /* atoms that mean put the stuff in the prolog database instead of
  571.    a file.
  572. */
  573.  
  574.  
  575. means_put_in_prolog_idb( X     )     :-
  576.       write_fact_trace([$e means_put_in_prolog_idb , Arg = $, X]),
  577.       fail.
  578.  
  579. means_put_in_prolog_idb( prolog_idb)  :- !.
  580. means_put_in_prolog_idb( String    )  :-
  581.      string( String),
  582.      string_search( prolog_idb, String, _),!.
  583.  
  584.  
  585. /********************** end of file **************************************/
  586. /********************** end of file **************************************/
  587.